;;; examples-of-lexical-addressing-and-tail-call-annotation.scm
;;; Examples of what my compiler outputs for the tail-call annotation
;;; and lexical addressing problems. Note that my compiler generates
;;; slightly different tags for the AST than what the class was asked
;;; to generate. This should not be a problem.
;;;
;;; Programmer: Mayer Goldberg, 2009

(load "H://hw3/hw3/q12/compiler.scm")
(load "H:/hw4/q1.ss")


(equal? (annotate-tail-calls (parse '(lambda (x) (x x))) #t)
        `(lambda-simple (x) (tc-applic (var x) ((var x)))))

;>> ((lambda (x) (x x)) (lambda (x) (x x)))
;(tc-applic
; (lambda-simple (x) (tc-applic (pvar x 0) ((pvar x 0))))
; ((lambda-simple (x) (tc-applic (pvar x 0) ((pvar x 0))))))
;>> (lambda (x) (x (x x)))
;(lambda-simple
; (x)
; (tc-applic (pvar x 0) ((applic (pvar x 0) ((pvar x 0))))))
;>> (define fact
;     (lambda (n)
;       (if (zero? n) 
;	   1
;	   (* n (fact (- n 1))))))
;(def (fvar fact)
;     (lambda-simple
;      (n)
;      (if3 (applic (fvar zero?) ((pvar n 0)))
;	   (const 1)
;	   (tc-applic
;	    (fvar *)
;	    ((pvar n 0)
;	     (applic
;	      (fvar fact)
;	      ((applic (fvar -) ((pvar n 0) (const 1))))))))))
;>> (define y
;     (lambda (f)
;       ((lambda (x)
;	  (f (lambda args
;	       (apply (x x) args))))
;	(lambda (x)
;	  (f (lambda args
;	       (apply (x x) args)))))))
;(def (fvar y)
;     (lambda-simple
;      (f)
;      (tc-applic
;       (lambda-simple
;	(x)
;	(tc-applic
;	 (bvar f 0 0)
;	 ((lambda-var
;	   args
;	   (tc-applic
;	    (fvar apply)
;	    ((applic (bvar x 0 0) ((bvar x 0 0))) (pvar args 0)))))))
;       ((lambda-simple
;	 (x)
;	 (tc-applic
;	  (bvar f 0 0)
;	  ((lambda-var
;	    args
;	    (tc-applic
;	     (fvar apply)
;	     ((applic (bvar x 0 0) ((bvar x 0 0)))
;	      (pvar args 0)))))))))))
;>> (lambda (a) 
;     (lambda (b)
;       (lambda (c)
;	 ((a c) (b c)))))
;(lambda-simple
; (a)
; (lambda-simple
;  (b)
;  (lambda-simple
;   (c)
;   (tc-applic
;    (applic (bvar a 1 0) ((pvar c 0)))
;    ((applic (bvar b 0 0) ((pvar c 0))))))))
;>> (define order
;     (lambda (<)
;       (letrec ((loop
;		 (lambda (a s)
;		   (or (null? s)
;		       (and (< a (car s))
;			    (loop (car s) (cdr s)))))))
;	 (lambda (a . s)
;	   (loop a s)))))
;(def (fvar order)
;     (lambda-simple
;      (<)
;      (tc-applic
;       (lambda-simple
;	(loop)
;	(seq ((set (pvar loop 0)
;		   (applic (fvar cons) ((pvar loop 0) (const ()))))
;	      (applic
;	       (fvar set-car!)
;	       ((pvar loop 0)
;		(lambda-simple
;		 (a s)
;		 (or ((applic (fvar null?) ((pvar s 1)))
;		      (if3 (applic
;			    (bvar < 1 0)
;			    ((pvar a 0)
;			     (applic (fvar car) ((pvar s 1)))))
;			   (tc-applic
;			    (applic (fvar car) ((bvar loop 0 0)))
;			    ((applic (fvar car) ((pvar s 1)))
;			     (applic (fvar cdr) ((pvar s 1)))))
;			   (const #f)))))))
;	      (lambda-opt
;	       (a)
;	       s
;	       (tc-applic
;		(applic (fvar car) ((bvar loop 0 0)))
;		((pvar a 0) (pvar s 1)))))))
;       ((const #f)))))
;>> (define map
;     (letrec ((map-list
;	       (lambda (f lists)
;		 (if (null? (car lists)) '()
;		     (cons (apply f (map-one car lists))
;			   (map-list f (map-one cdr lists))))))
;	      (map-one
;	       (lambda (f s)
;		 (if (null? s) '()
;		     (cons (f (car s))
;			   (map-one f (cdr s)))))))
;       (lambda (f . args)
;	 (map-list f args))))
;(def (fvar map)
;     (applic
;      (lambda-simple
;       (map-list map-one)
;       (seq ((set (pvar map-list 0)
;		  (applic (fvar cons) ((pvar map-list 0) (const ()))))
;	     (set (pvar map-one 1)
;		  (applic (fvar cons) ((pvar map-one 1) (const ()))))
;	     (applic
;	      (fvar set-car!)
;	      ((pvar map-list 0)
;	       (lambda-simple
;		(f lists)
;		(if3 (applic
;		      (fvar null?)
;		      ((applic (fvar car) ((pvar lists 1)))))
;		     (const ())
;		     (tc-applic
;		      (fvar cons)
;		      ((applic
;			(fvar apply)
;			((pvar f 0)
;			 (applic
;			  (applic
;			   (fvar car)
;			   ((bvar map-one 0 1)))
;			  ((fvar car) (pvar lists 1)))))
;		       (applic
;			(applic (fvar car) ((bvar map-list 0 0)))
;			((pvar f 0)
;			 (applic
;			  (applic
;			   (fvar car)
;			   ((bvar map-one 0 1)))
;			  ((fvar cdr) (pvar lists 1)))))))))))
;	     (applic
;	      (fvar set-car!)
;	      ((pvar map-one 1)
;	       (lambda-simple
;		(f s)
;		(if3 (applic (fvar null?) ((pvar s 1)))
;		     (const ())
;		     (tc-applic
;		      (fvar cons)
;		      ((applic
;			(pvar f 0)
;			((applic (fvar car) ((pvar s 1)))))
;		       (applic
;			(applic (fvar car) ((bvar map-one 0 1)))
;			((pvar f 0)
;			 (applic (fvar cdr) ((pvar s 1)))))))))))
;	     (lambda-opt
;	      (f)
;	      args
;	      (tc-applic
;	       (applic (fvar car) ((bvar map-list 0 0)))
;	       ((pvar f 0) (pvar args 1)))))))
;      ((const #f) (const #f))))
;>> (define member?
;     (lambda (a s)
;       (ormap (lambda (b) (eq? a b)) s)))
;(def (fvar member?)
;     (lambda-simple
;      (a s)
;      (tc-applic
;       (fvar ormap)
;       ((lambda-simple
;	 (b)
;	 (tc-applic (fvar eq?) ((bvar a 0 0) (pvar b 0))))
;	(pvar s 1)))))
;>> (define andmap
;     (lambda (f . s)
;       (letrec ((loop
;		 (lambda (s)
;		   (or (null? (car s))
;		       (and (apply f (map car s))
;			    (loop (map cdr s)))))))
;	 (loop s))))
;(def (fvar andmap)
;     (lambda-opt
;      (f)
;      s
;      (tc-applic
;       (lambda-simple
;	(loop)
;	(seq ((set (pvar loop 0)
;		   (applic (fvar cons) ((pvar loop 0) (const ()))))
;	      (applic
;	       (fvar set-car!)
;	       ((pvar loop 0)
;		(lambda-simple
;		 (s)
;		 (or ((applic
;		       (fvar null?)
;		       ((applic (fvar car) ((pvar s 0)))))
;		      (if3 (applic
;			    (fvar apply)
;			    ((bvar f 1 0)
;			     (applic
;			      (fvar map)
;			      ((fvar car) (pvar s 0)))))
;			   (tc-applic
;			    (applic (fvar car) ((bvar loop 0 0)))
;			    ((applic
;			      (fvar map)
;			      ((fvar cdr) (pvar s 0)))))
;			   (const #f)))))))
;	      (tc-applic
;	       (applic (fvar car) ((pvar loop 0)))
;	       ((bvar s 0 1))))))
;       ((const #f)))))
;>> (define string->list
;     (letrec ((loop
;	       (lambda (str n s)
;		 (if (= n -1) s
;		     (loop str
;			   (- n 1)
;			   (cons (string-ref str n) s))))))
;       (lambda (str)
;	 (loop str (- (string-length str) 1) '()))))
;(def (fvar string->list)
;     (applic
;      (lambda-simple
;       (loop)
;       (seq ((set (pvar loop 0)
;		  (applic (fvar cons) ((pvar loop 0) (const ()))))
;	     (applic
;	      (fvar set-car!)
;	      ((pvar loop 0)
;	       (lambda-simple
;		(str n s)
;		(if3 (applic (fvar =) ((pvar n 1) (const -1)))
;		     (pvar s 2)
;		     (tc-applic
;		      (applic (fvar car) ((bvar loop 0 0)))
;		      ((pvar str 0)
;		       (applic (fvar -) ((pvar n 1) (const 1)))
;		       (applic
;			(fvar cons)
;			((applic
;			  (fvar string-ref)
;			  ((pvar str 0) (pvar n 1)))
;			 (pvar s 2)))))))))
;	     (lambda-simple
;	      (str)
;	      (tc-applic
;	       (applic (fvar car) ((bvar loop 0 0)))
;	       ((pvar str 0)
;		(applic
;		 (fvar -)
;		 ((applic (fvar string-length) ((pvar str 0)))
;		  (const 1)))
;		(const ())))))))
;      ((const #f))))
;>> (define is-equal?
;     (let ((void-object (if #f #f)))
;       (letrec ((equal?
;		 (lambda (a b)
;		   (cond
;		    ;; bool
;		    ((and (boolean? a) (boolean? b))
;		     (if a b (not b)))
;		    ;; char
;		    ((and (char? a) (char? b)) (char=? a b))
;		    ;; nil
;		    ((null? a) (null? b))
;		    ;; number
;		    ((and (number? a) (number? b)) (= a b))
;		    ;; pair
;		    ((and (pair? a) (pair? b))
;		     (and (equal? (car a) (car b))
;			  (equal? (cdr a) (cdr b))))
;		    ;; string
;		    ((and (string? a) (string? b)) (string=? a b))
;		    ;; symbol
;		    ((and (symbol? a) (symbol? b)) (eq? a b))
;		    ;; vector
;		    ((and (vector? a) (vector? b)
;			  (= (vector-length a) (vector-length b)))
;		     (map equal? (vector->list a) (vector->list b)))
;		    ;; void
;		    ((eq? a void-object) (eq? b void-object))
;		    (else #f)))))
;	 equal?)))
;(def (fvar is-equal?)
;     (applic
;      (lambda-simple
;       (void-object)
;       (tc-applic
;	(lambda-simple
;	 (equal?)
;	 (seq ((set (pvar equal? 0)
;		    (applic (fvar cons) ((pvar equal? 0) (const ()))))
;	       (applic
;		(fvar set-car!)
;		((pvar equal? 0)
;		 (lambda-simple
;		  (a b)
;		  (if3 (if3 (applic (fvar boolean?) ((pvar a 0)))
;			    (applic (fvar boolean?) ((pvar b 1)))
;			    (const #f))
;		       (if3 (pvar a 0)
;			    (pvar b 1)
;			    (tc-applic (fvar not) ((pvar b 1))))
;		       (if3 (if3 (applic (fvar char?) ((pvar a 0)))
;				 (applic (fvar char?) ((pvar b 1)))
;				 (const #f))
;			    (tc-applic
;			     (fvar char=?)
;			     ((pvar a 0) (pvar b 1)))
;			    (if3 (applic (fvar null?) ((pvar a 0)))
;				 (tc-applic
;				  (fvar null?)
;				  ((pvar b 1)))
;				 (if3 (if3 (applic
;					    (fvar number?)
;					    ((pvar a 0)))
;					   (applic
;					    (fvar number?)
;					    ((pvar b 1)))
;					   (const #f))
;				      (tc-applic
;				       (fvar =)
;				       ((pvar a 0) (pvar b 1)))
;				      (if3 (if3 (applic
;						 (fvar pair?)
;						 ((pvar a 0)))
;						(applic
;						 (fvar pair?)
;						 ((pvar b 1)))
;						(const #f))
;					   (if3 (applic
;						 (applic
;						  (fvar car)
;						  ((bvar
;						    equal?
;						    0
;						    0)))
;						 ((applic
;						   (fvar car)
;						   ((pvar a 0)))
;						  (applic
;						   (fvar car)
;						   ((pvar
;						     b
;						     1)))))
;						(tc-applic
;						 (applic
;						  (fvar car)
;						  ((bvar
;						    equal?
;						    0
;						    0)))
;						 ((applic
;						   (fvar cdr)
;						   ((pvar a 0)))
;						  (applic
;						   (fvar cdr)
;						   ((pvar
;						     b
;						     1)))))
;						(const #f))
;					   (if3 (if3 (applic
;						      (fvar
;						       string?)
;						      ((pvar
;							a
;							0)))
;						     (applic
;						      (fvar
;						       string?)
;						      ((pvar
;							b
;							1)))
;						     (const #f))
;						(tc-applic
;						 (fvar string=?)
;						 ((pvar a 0)
;						  (pvar b 1)))
;						(if3 (if3 (applic
;							   (fvar
;							    symbol?)
;							   ((pvar
;							     a
;							     0)))
;							  (applic
;							   (fvar
;							    symbol?)
;							   ((pvar
;							     b
;							     1)))
;							  (const
;							   #f))
;						     (tc-applic
;						      (fvar eq?)
;						      ((pvar a 0)
;						       (pvar
;							b
;							1)))
;						     (if3 (if3 (applic
;								(fvar
;								 vector?)
;								((pvar
;								  a
;								  0)))
;							       (if3 (applic
;								     (fvar
;								      vector?)
;								     ((pvar
;								       b
;								       1)))
;								    (applic
;								     (fvar
;								      =)
;								     ((applic
;								       (fvar
;									vector-length)
;								       ((pvar
;									 a
;									 0)))
;								      (applic
;								       (fvar
;									vector-length)
;								       ((pvar
;									 b
;									 1)))))
;								    (const
;								     #f))
;							       (const
;								#f))
;							  (tc-applic
;							   (fvar
;							    map)
;							   ((applic
;							     (fvar
;							      car)
;							     ((bvar
;							       equal?
;							       0
;							       0)))
;							    (applic
;							     (fvar
;							      vector->list)
;							     ((pvar
;							       a
;							       0)))
;							    (applic
;							     (fvar
;							      vector->list)
;							     ((pvar
;							       b
;							       1)))))
;							  (if3 (applic
;								(fvar
;								 eq?)
;								((pvar
;								  a
;								  0)
;								 (bvar
;								  void-object
;								  1
;								  0)))
;							       (tc-applic
;								(fvar
;								 eq?)
;								((pvar
;								  b
;								  1)
;								 (bvar
;								  void-object
;								  1
;								  0)))
;							       (const
;								#f)))))))))))))
;	       (tc-applic (fvar car) ((pvar equal? 0))))))
;	((const #f))))
;      ((if3 (const #f) (const #f) (const #<void>)))))
;>> (define bin
;     (lambda (n s)
;       (if (zero? n) (list s)
;	   (append
;	    (bin (sub1 n) (cons 0 s))
;	    (bin (sub1 n) (cons 1 s))))))
;(def (fvar bin)
;     (lambda-simple
;      (n s)
;      (if3 (applic (fvar zero?) ((pvar n 0)))
;	   (tc-applic (fvar list) ((pvar s 1)))
;	   (tc-applic
;	    (fvar append)
;	    ((applic
;	      (fvar bin)
;	      ((applic (fvar sub1) ((pvar n 0)))
;	       (applic (fvar cons) ((const 0) (pvar s 1)))))
;	     (applic
;	      (fvar bin)
;	      ((applic (fvar sub1) ((pvar n 0)))
;	       (applic (fvar cons) ((const 1) (pvar s 1))))))))))
;>> (define cross-map
;     (lambda (s f)
;       (letrec ((run-h
;		 (lambda (s args)
;		   (if (null? s)
;		       (list (apply f (reverse args)))
;		       (run-v (car s) (cdr s) args))))
;		(run-v
;		 (lambda (n s args)
;		   (if (zero? n)
;		       '()
;		       (append
;			(run-h s (cons (- n 1) args))
;			(run-v (- n 1) s args))))))
;	 (run-h s '()))))
;(def (fvar cross-map)
;     (lambda-simple
;      (s f)
;      (tc-applic
;       (lambda-simple
;	(run-h run-v)
;	(seq ((set (pvar run-h 0)
;		   (applic (fvar cons) ((pvar run-h 0) (const ()))))
;	      (set (pvar run-v 1)
;		   (applic (fvar cons) ((pvar run-v 1) (const ()))))
;	      (applic
;	       (fvar set-car!)
;	       ((pvar run-h 0)
;		(lambda-simple
;		 (s args)
;		 (if3 (applic (fvar null?) ((pvar s 0)))
;		      (tc-applic
;		       (fvar list)
;		       ((applic
;			 (fvar apply)
;			 ((bvar f 1 1)
;			  (applic
;			   (fvar reverse)
;			   ((pvar args 1)))))))
;		      (tc-applic
;		       (applic (fvar car) ((bvar run-v 0 1)))
;		       ((applic (fvar car) ((pvar s 0)))
;			(applic (fvar cdr) ((pvar s 0)))
;			(pvar args 1)))))))
;	      (applic
;	       (fvar set-car!)
;	       ((pvar run-v 1)
;		(lambda-simple
;		 (n s args)
;		 (if3 (applic (fvar zero?) ((pvar n 0)))
;		      (const ())
;		      (tc-applic
;		       (fvar append)
;		       ((applic
;			 (applic (fvar car) ((bvar run-h 0 0)))
;			 ((pvar s 1)
;			  (applic
;			   (fvar cons)
;			   ((applic
;			     (fvar -)
;			     ((pvar n 0) (const 1)))
;			    (pvar args 2)))))
;			(applic
;			 (applic (fvar car) ((bvar run-v 0 1)))
;			 ((applic
;			   (fvar -)
;			   ((pvar n 0) (const 1)))
;			  (pvar s 1)
;			  (pvar args 2)))))))))
;	      (tc-applic
;	       (applic (fvar car) ((pvar run-h 0)))
;	       ((bvar s 0 0) (const ()))))))
;       ((const #f) (const #f)))))
;>> (define show
;     ((lambda (ma)
;	((lambda (ai)
;	   (lambda (board)
;	     ((board (ma ai 'x) (ma ai 'o) (ma ai'_))
;	      (lambda (x y) (lambda (r) `(lambda (x o _) ,r)))
;	      #f)))
;	 (lambda (m1 m2)
;	   (lambda (c)
;	     (lambda (b)
;	       (lambda (a)
;		 (ma m1 (list a b c))))))))
;      (lambda (m r) (lambda (x y) ((x y m) r)))))
;(def (fvar show)
;     (applic
;      (lambda-simple
;       (ma)
;       (tc-applic
;	(lambda-simple
;	 (ai)
;	 (lambda-simple
;	  (board)
;	  (tc-applic
;	   (applic
;	    (pvar board 0)
;	    ((applic (bvar ma 1 0) ((bvar ai 0 0) (const x)))
;	     (applic (bvar ma 1 0) ((bvar ai 0 0) (const o)))
;	     (applic (bvar ma 1 0) ((bvar ai 0 0) (const _)))))
;	   ((lambda-simple
;	     (x y)
;	     (lambda-simple
;	      (r)
;	      (tc-applic
;	       (fvar append)
;	       ((const (lambda))
;		(applic
;		 (fvar append)
;		 ((applic
;		   (fvar list)
;		   ((applic
;		     (fvar append)
;		     ((const (x))
;		      (applic
;		       (fvar append)
;		       ((const (o))
;			(applic
;			 (fvar append)
;			 ((const (_)) (const ())))))))))
;		  (applic
;		   (fvar append)
;		   ((applic (fvar list) ((pvar r 0)))
;		    (const ())))))))))
;	    (const #f)))))
;	((lambda-simple
;	  (m1 m2)
;	  (lambda-simple
;	   (c)
;	   (lambda-simple
;	    (b)
;	    (lambda-simple
;	     (a)
;	     (tc-applic
;	      (bvar ma 3 0)
;	      ((bvar m1 2 0)
;	       (applic
;		(fvar list)
;		((pvar a 0) (bvar b 0 0) (bvar c 1 0))))))))))))
;      ((lambda-simple
;	(m r)
;	(lambda-simple
;	 (x y)
;	 (tc-applic
;	  (applic (pvar x 0) ((pvar y 1) (bvar m 0 0)))
;	  ((bvar r 0 1))))))))
;>> (define qsort
;     (lambda (s)
;       (if (null? s) '()
;	   (split (car s) (cdr s)
;		  (lambda (ll gl)
;		    (append (qsort ll)
;			    (list (car s))
;			    (qsort gl)))))))
;(def (fvar qsort)
;     (lambda-simple
;      (s)
;      (if3 (applic (fvar null?) ((pvar s 0)))
;	   (const ())
;	   (tc-applic
;	    (fvar split)
;	    ((applic (fvar car) ((pvar s 0)))
;	     (applic (fvar cdr) ((pvar s 0)))
;	     (lambda-simple
;	      (ll gl)
;	      (tc-applic
;	       (fvar append)
;	       ((applic (fvar qsort) ((pvar ll 0)))
;		(applic
;		 (fvar list)
;		 ((applic (fvar car) ((bvar s 0 0)))))
;		(applic (fvar qsort) ((pvar gl 1)))))))))))
;>> (define split
;     (lambda (pivot s ret-ll+gl)
;       (if (null? s) (ret-ll+gl '() '())
;	   (split pivot (cdr s)
;		  (lambda (ll gl)
;		    (if (<= (car s) pivot)
;			(ret-ll+gl (cons (car s) ll) gl)
;			(ret-ll+gl ll (cons (car s) gl))))))))
;(def (fvar split)
;     (lambda-simple
;      (pivot s ret-ll+gl)
;      (if3 (applic (fvar null?) ((pvar s 1)))
;	   (tc-applic (pvar ret-ll+gl 2) ((const ()) (const ())))
;	   (tc-applic
;	    (fvar split)
;	    ((pvar pivot 0)
;	     (applic (fvar cdr) ((pvar s 1)))
;	     (lambda-simple
;	      (ll gl)
;	      (if3 (applic
;		    (fvar <=)
;		    ((applic (fvar car) ((bvar s 0 1)))
;		     (bvar pivot 0 0)))
;		   (tc-applic
;		    (bvar ret-ll+gl 0 2)
;		    ((applic
;		      (fvar cons)
;		      ((applic (fvar car) ((bvar s 0 1)))
;		       (pvar ll 0)))
;		     (pvar gl 1)))
;		   (tc-applic
;		    (bvar ret-ll+gl 0 2)
;		    ((pvar ll 0)
;		     (applic
;		      (fvar cons)
;		      ((applic (fvar car) ((bvar s 0 1)))
;		       (pvar gl 1))))))))))))
;>> (a (lambda (a) (a (lambda (b) (a b (lambda (a) (a b (lambda (c) (a b c)))))))))
;(tc-applic
; (fvar a)
; ((lambda-simple
;   (a)
;   (tc-applic
;    (pvar a 0)
;    ((lambda-simple
;      (b)
;      (tc-applic
;       (bvar a 0 0)
;       ((pvar b 0)
;	(lambda-simple
;	 (a)
;	 (tc-applic
;	  (pvar a 0)
;	  ((bvar b 0 0)
;	   (lambda-simple
;	    (c)
;	    (tc-applic
;	     (bvar a 0 0)
;	     ((bvar b 1 0) (pvar c 0)))))))))))))))
;>> (define list->string
;     (lambda (s)
;       (let* ((n (length s))
;	      (str (make-string n)))
;	 (letrec ((loop
;		   (lambda (s i)
;		     (if (= i n) str
;			 (begin
;			   (string-set! str i (car s))
;			   (loop (cdr s) (+ i 1)))))))
;	   (loop s 0)))))
;(def (fvar list->string)
;     (lambda-simple
;      (s)
;      (tc-applic
;       (lambda-simple
;	(n)
;	(tc-applic
;	 (lambda-simple
;	  (str)
;	  (tc-applic
;	   (lambda-simple
;	    (loop)
;	    (seq ((set (pvar loop 0)
;		       (applic
;			(fvar cons)
;			((pvar loop 0) (const ()))))
;		  (applic
;		   (fvar set-car!)
;		   ((pvar loop 0)
;		    (lambda-simple
;		     (s i)
;		     (if3 (applic
;			   (fvar =)
;			   ((pvar i 1) (bvar n 2 0)))
;			  (bvar str 1 0)
;			  (seq ((applic
;				 (fvar string-set!)
;				 ((bvar str 1 0)
;				  (pvar i 1)
;				  (applic
;				   (fvar car)
;				   ((pvar s 0)))))
;				(tc-applic
;				 (applic
;				  (fvar car)
;				  ((bvar loop 0 0)))
;				 ((applic
;				   (fvar cdr)
;				   ((pvar s 0)))
;				  (applic
;				   (fvar +)
;				   ((pvar i 1)
;				    (const 1)))))))))))
;		  (tc-applic
;		   (applic (fvar car) ((pvar loop 0)))
;		   ((bvar s 2 0) (const 0))))))
;	   ((const #f))))
;	 ((applic (fvar make-string) ((pvar n 0))))))
;       ((applic (fvar length) ((pvar s 0)))))))
;>> (define list->vector
;     (lambda (s)
;       (let* ((n (length s))
;	      (v (make-vector n)))
;	 (letrec ((loop
;		   (lambda (s i)
;		     (if (= i n) v
;			 (begin
;			   (vector-set! v i (car s))
;			   (loop (cdr s) (+ i 1)))))))
;	   (loop s 0)))))
;(def (fvar list->vector)
;     (lambda-simple
;      (s)
;      (tc-applic
;       (lambda-simple
;	(n)
;	(tc-applic
;	 (lambda-simple
;	  (v)
;	  (tc-applic
;	   (lambda-simple
;	    (loop)
;	    (seq ((set (pvar loop 0)
;		       (applic
;			(fvar cons)
;			((pvar loop 0) (const ()))))
;		  (applic
;		   (fvar set-car!)
;		   ((pvar loop 0)
;		    (lambda-simple
;		     (s i)
;		     (if3 (applic
;			   (fvar =)
;			   ((pvar i 1) (bvar n 2 0)))
;			  (bvar v 1 0)
;			  (seq ((applic
;				 (fvar vector-set!)
;				 ((bvar v 1 0)
;				  (pvar i 1)
;				  (applic
;				   (fvar car)
;				   ((pvar s 0)))))
;				(tc-applic
;				 (applic
;				  (fvar car)
;				  ((bvar loop 0 0)))
;				 ((applic
;				   (fvar cdr)
;				   ((pvar s 0)))
;				  (applic
;				   (fvar +)
;				   ((pvar i 1)
;				    (const 1)))))))))))
;		  (tc-applic
;		   (applic (fvar car) ((pvar loop 0)))
;		   ((bvar s 2 0) (const 0))))))
;	   ((const #f))))
;	 ((applic (fvar make-vector) ((pvar n 0))))))
;       ((applic (fvar length) ((pvar s 0)))))))
;>> (define pred
;     (lambda (n)
;       (lambda (z)
;	 (lambda (w)
;	   (let
;	       ((M (lambda (m)
;		     (lambda (b2)
;		       (lambda (r21)
;			 (lambda (r22)
;			   (lambda (s2)
;			     (lambda (b1)
;			       (lambda (r11)
;				 (lambda (r12)
;				   (lambda (s1)
;				     ((s1
;				       (((b1
;					  (((b2 (quintuple m b2 (r12 w) (r12 w) U01))
;					    (quintuple m b2 (r12 w) (r12 w) U01))
;					   (r12 w)))
;					 (((b2 (quintuple m b2 r11 (r12 z) U11))
;					   (quintuple m b2 r11 (r12 z) U11))
;					  r11))
;					I))
;				      (((b1 (((b2 (quintuple m b2 r11 (r12 z) U11))
;					      (quintuple m b2 r11 (r12 z) U11))
;					     r11))
;					(((b2 (quintuple m b2 (r12 w) (r12 w) U11))
;					  (quintuple m b2 (r12 w) (r12 w) U11))
;					 (r12 w)))
;				       I)))))))))))))
;	     (((n (quintuple M U02 z I U01))
;	       (quintuple M U12 z I U01))
;	      (quintuple M U22 z I U01)))))))
;(def (fvar pred)
;     (lambda-simple
;      (n)
;      (lambda-simple
;       (z)
;       (lambda-simple
;	(w)
;	(tc-applic
;	 (lambda-simple
;	  (M)
;	  (tc-applic
;	   (applic
;	    (applic
;	     (bvar n 2 0)
;	     ((applic
;	       (fvar quintuple)
;	       ((pvar M 0)
;		(fvar U02)
;		(bvar z 1 0)
;		(fvar I)
;		(fvar U01)))))
;	    ((applic
;	      (fvar quintuple)
;	      ((pvar M 0)
;	       (fvar U12)
;	       (bvar z 1 0)
;	       (fvar I)
;	       (fvar U01)))))
;	   ((applic
;	     (fvar quintuple)
;	     ((pvar M 0)
;	      (fvar U22)
;	      (bvar z 1 0)
;	      (fvar I)
;	      (fvar U01))))))
;	 ((lambda-simple
;	   (m)
;	   (lambda-simple
;	    (b2)
;	    (lambda-simple
;	     (r21)
;	     (lambda-simple
;	      (r22)
;	      (lambda-simple
;	       (s2)
;	       (lambda-simple
;		(b1)
;		(lambda-simple
;		 (r11)
;		 (lambda-simple
;		  (r12)
;		  (lambda-simple
;		   (s1)
;		   (tc-applic
;		    (applic
;		     (pvar s1 0)
;		     ((applic
;		       (applic
;			(applic
;			 (bvar b1 2 0)
;			 ((applic
;			   (applic
;			    (applic
;			     (bvar b2 6 0)
;			     ((applic
;			       (fvar quintuple)
;			       ((bvar m 7 0)
;				(bvar b2 6 0)
;				(applic
;				 (bvar r12 0 0)
;				 ((bvar w 8 0)))
;				(applic
;				 (bvar r12 0 0)
;				 ((bvar w 8 0)))
;				(fvar U01)))))
;			    ((applic
;			      (fvar quintuple)
;			      ((bvar m 7 0)
;			       (bvar b2 6 0)
;			       (applic
;				(bvar r12 0 0)
;				((bvar w 8 0)))
;			       (applic
;				(bvar r12 0 0)
;				((bvar w 8 0)))
;			       (fvar U01)))))
;			   ((applic
;			     (bvar r12 0 0)
;			     ((bvar w 8 0)))))))
;			((applic
;			  (applic
;			   (applic
;			    (bvar b2 6 0)
;			    ((applic
;			      (fvar quintuple)
;			      ((bvar m 7 0)
;			       (bvar b2 6 0)
;			       (bvar r11 1 0)
;			       (applic
;				(bvar r12 0 0)
;				((bvar z 9 0)))
;			       (fvar U11)))))
;			   ((applic
;			     (fvar quintuple)
;			     ((bvar m 7 0)
;			      (bvar b2 6 0)
;			      (bvar r11 1 0)
;			      (applic
;			       (bvar r12 0 0)
;			       ((bvar z 9 0)))
;			      (fvar U11)))))
;			  ((bvar r11 1 0)))))
;		       ((fvar I)))))
;		    ((applic
;		      (applic
;		       (applic
;			(bvar b1 2 0)
;			((applic
;			  (applic
;			   (applic
;			    (bvar b2 6 0)
;			    ((applic
;			      (fvar quintuple)
;			      ((bvar m 7 0)
;			       (bvar b2 6 0)
;			       (bvar r11 1 0)
;			       (applic
;				(bvar r12 0 0)
;				((bvar z 9 0)))
;			       (fvar U11)))))
;			   ((applic
;			     (fvar quintuple)
;			     ((bvar m 7 0)
;			      (bvar b2 6 0)
;			      (bvar r11 1 0)
;			      (applic
;			       (bvar r12 0 0)
;			       ((bvar z 9 0)))
;			      (fvar U11)))))
;			  ((bvar r11 1 0)))))
;		       ((applic
;			 (applic
;			  (applic
;			   (bvar b2 6 0)
;			   ((applic
;			     (fvar quintuple)
;			     ((bvar m 7 0)
;			      (bvar b2 6 0)
;			      (applic
;			       (bvar r12 0 0)
;			       ((bvar w 8 0)))
;			      (applic
;			       (bvar r12 0 0)
;			       ((bvar w 8 0)))
;			      (fvar U11)))))
;			  ((applic
;			    (fvar quintuple)
;			    ((bvar m 7 0)
;			     (bvar b2 6 0)
;			     (applic
;			      (bvar r12 0 0)
;			      ((bvar w 8 0)))
;			     (applic
;			      (bvar r12 0 0)
;			      ((bvar w 8 0)))
;			     (fvar U11)))))
;			 ((applic
;			   (bvar r12 0 0)
;			   ((bvar w 8 0)))))))
;		      ((fvar I))))))))))))))))))))
;>> (define Yn
;     (lambda fs
;       (let ((ms (map
;		     (lambda (fi)
;		       (lambda ms
;			 (apply fi (map (lambda (mi)
;					  (lambda args
;					    (apply (apply mi ms) args))) ms))))
;		   fs)))
;	 (apply (car ms) ms))))
;(def (fvar Yn)
;     (lambda-var
;      fs
;      (tc-applic
;       (lambda-simple
;	(ms)
;	(tc-applic
;	 (fvar apply)
;	 ((applic (fvar car) ((pvar ms 0))) (pvar ms 0))))
;       ((applic
;	 (fvar map)
;	 ((lambda-simple
;	   (fi)
;	   (lambda-var
;	    ms
;	    (tc-applic
;	     (fvar apply)
;	     ((bvar fi 0 0)
;	      (applic
;	       (fvar map)
;	       ((lambda-simple
;		 (mi)
;		 (lambda-var
;		  args
;		  (tc-applic
;		   (fvar apply)
;		   ((applic
;		     (fvar apply)
;		     ((bvar mi 0 0) (bvar ms 1 0)))
;		    (pvar args 0)))))
;		(pvar ms 0)))))))
;	  (pvar fs 0)))))))
